Lab_05

Which airlines had the best and worst track records of on-time departures in each month? Is it different between PDX and SEA?

Average_track_PDX<-track_record_PDX%>%
    group_by(month) %>% 
    slice(which.min(Avg_dep_delay),which.max(Avg_dep_delay))

Average_track_PDX%>%gt(groupname_col = "month") %>%
  tab_header(title="PDX-Best and worst carrier in depature delay each month")%>%
  cols_label(month="Month",carrier="Carrier",Avg_dep_delay="Average dep delay")%>%
  cols_align(align="center") %>%
  tab_style(
    cell_text(style = "italic"),
    locations = cells_title(groups=c("title"))
  )

The above table shows the best and worst airline departure delay every month.It seems in month 1st,best is HA whereas worst is F9, similarly in 2nd month, best is HA and worst is VX

flight_SEA<-flights%>%
  filter(origin=="SEA")
datatable(flight_SEA)

## Warning in instance$preRenderHook(instance): It seems your data is too big
## for client-side DataTables. You may consider server-side processing: https://
## rstudio.github.io/DT/server.html

track_record_SEA<-flight_SEA%>%
  group_by(month,carrier)%>%
  summarize(Avg_dep_delay=mean(dep_delay,na.rm = TRUE))%>%
  arrange(month,Avg_dep_delay)
datatable(track_record_SEA,rownames = FALSE)

Average_track_SEA<-track_record_SEA%>%
    group_by(month) %>% 
    slice(which.min(Avg_dep_delay),which.max(Avg_dep_delay))
Average_track_SEA%>%gt() %>%
  tab_header(title="SEA-Best and worst carrier in depature delay each month")%>%
  cols_label(month="Month",carrier="Carrier",Avg_dep_delay="Average dep delay")%>%
  cols_align(align="center") %>%
  tab_style(
    cell_text(style = "italic"),
    locations = cells_title(groups=c("title"))
  )

The best and worst track records of on-time departures of airlines in each month is different for PDX and SEA. For each city Portland and Seattle, it seems every month the position of best and worst airlines are getting changed, showing no consistency.

What cities have the most service from Portland (defined however you like, but do make sure to define it clearly!), and which have the worst?

most_service<-flight_PDX%>%
  group_by(dest)%>%
  summarise(flight=n())%>%
  arrange(desc(flight))
most_service%>%gt() %>%
  tab_header(title="PDX-Number of flights in each destination")%>%
  cols_label(dest="Destination",flight="Number of flights")%>%
  cols_align(align="center") %>%
  tab_style(
    cell_text(align = "right"), 
    locations = cells_title(groups = c("subtitle"))
  ) %>% 
  tab_style(
    cell_text(style = "italic"),
    locations = cells_title(groups=c("title"))
  )

max(most_service$flight)

## [1] 5179

Which airlines improved the most in terms of on-time departures over time, and on which routes? Which airlines got worse?

xtabs(Avg_dep_delay~carrier+month,track_record_PDX)

##        month
## carrier           1           2           3           4           5           6
##      AA  8.37158470 14.98125000 24.85245902 16.73888889 10.91959799 17.12500000
##      AS -1.18441815  2.48504983 -0.33514493 -1.72155412 -2.35434575  0.30747664
##      B6  9.10843373  9.25352113 -1.37974684  5.91764706  4.89565217  1.40157480
##      DL  4.05121294  9.17571885  2.09026128 -0.51288056  1.04444444  2.96007984
##      F9 21.10000000 13.79166667  6.11403509  2.67889908  7.64444444 18.11363636
##      HA -2.45161290 -2.17857143 -2.96774194 -6.13333333 -1.64516129 -3.83333333
##      OO  5.80552712  7.90307868  3.21081577  1.26673327  2.33487085  3.99004975
##      UA  9.12328767 15.69393140  5.80470588  1.46421268  7.90820312  8.21190893
##      US  4.36416185  1.06711409 -1.70370370  1.74626866 -1.21363636  2.20689655
##      VX -1.81609195 28.63157895  4.70588235  4.08139535  4.30337079  7.68852459
##      WN 15.82699387 17.22971114 10.31091510 11.33922652 11.21562156 16.84363296
##        month
## carrier           7           8           9          10          11          12
##      AA  6.90521327  9.50467290  8.90640394 13.70175439  8.61600000 19.36585366
##      AS  1.49910072  2.36147757  0.92829457  0.02506964  2.16844920  7.36274510
##      B6 11.67955801  6.30000000  7.38947368  2.83516484  8.20000000  3.21590909
##      DL  3.66785080  2.73713235  2.21250000  0.24129353  2.80169972  2.25490196
##      F9  9.42028986  1.98540146  4.76422764 -0.81415929  5.16666667 14.18181818
##      HA -2.48387097 -4.32258065 15.36666667  1.35483871  1.20000000 -1.35483871
##      OO  4.18908629  3.66990291  2.09876543  2.62011173  7.50389105 10.82581967
##      UA  6.45563140  6.94627383  5.44503546  7.40105079  5.42600897 10.79600887
##      US  4.32644628  0.46521739  0.26288660 -0.55801105  3.10691824  4.55688623
##      VX  7.29032258  6.45161290 -2.33333333 -5.12903226  4.44827586  7.13333333
##      WN 13.84475282  9.33173996  6.93010753  6.78040904  8.68858131 18.12652608

first_six_month<-flight_PDX%>%
  filter(month<7)
first_six_month_tidy<-first_six_month%>%
  group_by(carrier)%>%
  summarize(jan_to_june=median(dep_delay,na.rm = TRUE))
first_six_month_tidy%>%gt() %>%
  tab_header(title="PDX-dep_delay average from Jan to June")%>%
  cols_label(carrier="Carrier",jan_to_june="Jan to June")%>%
  cols_align(align="center") %>%
  tab_style(
    cell_text(align = "right"), 
    locations = cells_title(groups = c("subtitle"))
  ) %>% 
  tab_style(
    cell_text(style = "italic"),
    locations = cells_title(groups=c("title"))
  )

last_six_month<-flight_PDX%>%
  filter(month>6)
last_six_month_tidy<-last_six_month%>%
  group_by(carrier)%>%
  summarize(july_to_dec=median(dep_delay,na.rm = TRUE))
last_six_month_tidy%>%gt() %>%
  tab_header(title="PDX-dep_delay average from July to Dec")%>%
  cols_label(carrier="Carrier",july_to_dec="July to Dec")%>%
  cols_align(align="center") %>%
  tab_style(
    cell_text(align = "right"), 
    locations = cells_title(groups = c("subtitle"))
  ) %>% 
  tab_style(
    cell_text(style = "italic"),
    locations = cells_title(groups=c("title"))
  )

improvement<-merge(first_six_month_tidy,last_six_month_tidy,by="carrier")
improvement_final<-improvement%>%
  mutate(improvement_factor=july_to_dec-jan_to_june)%>%
  arrange(improvement_factor)

improvement_final%>%gt() %>%
  tab_header(title="PDX-Airlines improvement in dep_delay average ")%>%
  cols_label(carrier="Carrier",jan_to_june="Jan to June",july_to_dec="July to Dec",improvement_factor="Improvement factor")%>%
  cols_align(align="center") %>%
  tab_style(
    cell_text(align = "right"), 
    locations = cells_title(groups = c("subtitle"))
  ) %>% 
  tab_style(
    cell_text(style = "italic"),
    locations = cells_title(groups=c("title"))
  )

Using kable() function:

library(knitr)

## Warning: package 'knitr' was built under R version 3.6.3

library(kableExtra)

## Warning: package 'kableExtra' was built under R version 3.6.3

## 
## Attaching package: 'kableExtra'

## The following object is masked from 'package:dplyr':
## 
##     group_rows

first_Six<-flight_PDX%>%
  filter((carrier=="F9" | carrier=="HA")& month<7 )%>%
  group_by(dest,carrier)%>%
  summarize(first_avg=median(dep_delay,na.rm = TRUE))
column1=c("Destination","Carrier","First 6 month average")
first_Six%>%
    kable(format = "html", digits = 2, caption = "First six month average departure delay",col.names = column1) %>%
  kable_styling(bootstrap_options = "striped", full_width = F, position = "center")

last_Six<-flight_PDX%>%
  filter((carrier=="F9" | carrier=="HA")& month>6)%>%
  group_by(dest,carrier)%>%
  summarize(second_avg=median(dep_delay,na.rm = TRUE))
column2=c("Destination","Carrier","Last 6 month average")
last_Six%>%
  kable(format = "html", caption = "Last six month average departure delay",col.names = column2) %>% 
  kable_styling(bootstrap_options = "striped", full_width = F, position = "center")

final<-full_join(first_Six, last_Six, by = c("dest", "carrier"))%>%
  mutate(improvement_factor=second_avg-first_avg)

column=c("Destination","Carrier","First six month","Last 6 month","Improvement")
final%>% kable(format = "html", digits = 2, caption = "Improvement in average departure delay",col.names = column) %>% 
  kable_styling(bootstrap_options = "striped", full_width = F, position = "center")

FONTS

library(ggplot2)
library(extrafont)

## Warning: package 'extrafont' was built under R version 3.6.2

loadfonts(device = "win")
plot<-ggplot(improvement_final,aes(x=carrier,y=improvement_factor))+
  geom_col(aes(fill=improvement_factor))+
  theme(plot.title = element_text(hjust = 0.5)) +
  theme(axis.text = element_text(size = 15)) +
  labs(x = "Carrier", y = "Improvement in departure delay")+
  theme(panel.background = element_blank(),axis.line = element_line(colour = "black"))+
  theme(panel.border = element_rect(linetype = "dashed", fill = NA))+
  ggtitle(~""*underline("PDX-Airlines improvement in dep_delay average"))

Serif

library(extrafont)
loadfonts(device = "win")
library(showtext)

## Warning: package 'showtext' was built under R version 3.6.3

## Warning: package 'sysfonts' was built under R version 3.6.3

## Warning: package 'showtextdb' was built under R version 3.6.3

showtext_auto()
font_add_google("Tinos")
plot+theme(text=element_text(size=12,  family="Tinos",color = "brown"))

San - Serif

font_add_google("Open Sans")
plot+theme(text=element_text(size=12,  family="Open Sans",color = "brown"))

Google Display font - lobster

showtext_opts(dpi = 72)
font_add_google("Lobster", "lobster")
plot+theme(text=element_text(size=22,  family="lobster",color = "brown"))

##plot+theme(text=(family="lobster",col = "steelblue", size = 3))